unit fposUtils;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, sqlite3conn, SQLite3db, zbase, zCompres, zuncompr, md5, fpstructs;


function SetVendorName: string;
function GetFirePOSConfigDir: string;
function CreateConfig(fn: TFilename):Boolean;
function UpdateConfig(fn: TFilename; SQL: string): Boolean;
function CreateStocktake(fn: TFilename):Boolean;
function CreateSalesRegister(fn: TFilename):Boolean;
function CreateLogfile(fn: TFilename):Boolean;
function CreateSystemConfig(fn: TFilename):Boolean;
function CreateProfile(fn: TFilename; name, description: string): Boolean;
procedure SetDefaultProfile(fn: TFilename);
function ExecuteSQL (fn: TFilename; SQL: string): integer;
function Checksum( str1, str2, str3: string ): string;
function CheckPass( pass: string ): string;
function EscapeQuotes ( str: string ): string;
function EscapeLineEnding ( str: string ): string;
function UnEscapeLineEnding ( str: string ): string;
function EscapeApostrophe ( data: string ) : string;
function CompressBuffer( var Buffer: Pbyte; var bufferlen: Cardinal ) : Boolean;
function DeCompressBuffer( var Buffer: PByte; bufferlen, destlen: Cardinal ) : PChar;
function FormatNumber( Prefix: string; Num, Len: integer ): string;
function IsValidCost(Value: string): Boolean;
function MaxIntOf( int1, int2: Integer ): Integer;
function RandomString(len: Integer): string;
function DateTimeToJulianDateTime( datetime: TDateTime ): TJulianDateTime;
function DateTimeToJulianDateTimeAsString( datetime: TDateTime ): String;
function JulianDateTimeToDateTime( juliandatetime: TJulianDateTime ): TDateTime;
function JulianDateTimeToString( juliandatetime: TJulianDateTime ): String;
function FormatJulianDateTime(const FormatStr: string; DateTime: TJulianDateTime):string;

const
  VERSION_NUM = 0.1;
  UPDATE_CONFIG = 'updates.sql';

var
  CurrencyFormatString: string;

implementation

function SetVendorName: string;
begin
  Result := 'FirePOS';
end;

function GetFirePOSConfigDir: string;
var
  fn:TFilename;
  x: Integer;
begin
  Result:='';
  OnGetVendorName := @SetVendorName;
  fn := GetAppConfigDir(false);
  x := Pos(ApplicationName, fn);
  if x>0 then Result := system.Copy(fn, 1, x-1) + AnsiLowerCase(ApplicationName) + DirectorySeparator;
  if Not DirectoryExists(Result)
     then ForceDirectories(Result);
end;

function CreateConfig(fn: TFilename): Boolean;
var
  SQLDB: TSQLite;
  SQL: String;
begin
{$IFDEF DEBUG} writeln('CreateConfig'); {$ENDIF}
Result := false;
SQLDB := TSQLite.Create(fn);
if SQLDB <> nil then
   try
     SQL := 'BEGIN TRANSACTION;';
     SQL := SQL + 'CREATE TABLE Terminal (TerminalID integer UNIQUE, name text, serveraddress text, serverport integer, lastsale integer, datarevision integer);';
     SQL := SQL + 'INSERT INTO Terminal (TerminalID, name, lastsale, datarevision) VALUES (-1, "", 0, 0);';
     Result := SQLDB.Query(SQL, nil);
     if not Result
        then begin {$IFDEF DEBUG} writeln(SQLDB.LastErrorMessage); {$ENDIF} SQLDB.Query('ROLLBACK;', nil); end
        else SQLDB.Query('COMMIT;', nil);
   finally
     SQLDB.Free;
   end;
end;

function UpdateConfig(fn: TFilename; SQL: string): Boolean;
var
  SQLDB: TSQLite;
  SQLTransaction: string;

  procedure StoreUpdate;
  var
    UFile: Text;
    updatefile: TFilename;
  begin
    updatefile := ExtractFilePath(fn) + UPDATE_CONFIG;
    Assign(UFile, updatefile);
    try
      if FileExists(updatefile)
         then Append(UFile)
         else Rewrite(UFile);
    finally
       Close(UFile);
    end;
  end;

begin
{$IFDEF DEBUG} writeln('UpdateConfig'); {$ENDIF}
Result := false;
SQLDB := TSQLite.Create(fn);
if SQLDB <> nil then
   try
     SQLTransaction := 'BEGIN TRANSACTION;' + SQL;
     Result := SQLDB.Query(SQLTransaction, nil);
     if not Result
        then begin
               {$IFDEF DEBUG} writeln(SQLDB.LastErrorMessage); {$ENDIF}
               SQLDB.Query('ROLLBACK;', nil);
             end
        else begin
               SQLDB.Query('COMMIT;', nil);
               StoreUpdate;
             end;
   finally
     SQLDB.Free;
   end;
end;

function CreateStocktake(fn: TFilename): Boolean;
var
  SQLDB: TSQLite;
  SQL: String;
begin
  {$IFDEF DEBUG} writeln('CreateStocktake'); {$ENDIF}
  SQLDB := TSQLite.Create(fn);
  if SQLDB <> nil then
     try
       SQL := 'BEGIN TRANSACTION;';
       SQL := SQL + 'CREATE TABLE admin (createtime datetime DEFAULT CURRENT_TIMESTAMP, creator varchar(32), updatetime datetime);';
       SQL := SQL + 'INSERT INTO admin (creator) VALUES ("");' ;
       SQL := SQL + 'CREATE TABLE stocktake (barcode varchar(16), name varchar(32), count integer, cost float, date varchar(8), servercount integer);';
       Result := SQLDB.Query(SQL, nil);
       If not Result
          then begin
                 {$IFDEF DEBUG} writeln(SQLDB.LastErrorMessage); {$ENDIF}
                 SQLDB.Query('ROLLBACK;', nil);
               end
          else SQLDB.Query('COMMIT;', nil);
     finally
       SQLDB.Free;
     end;
end;

function CreateSalesRegister ( fn: TFilename ) : Boolean;
var
  SQLDB: TSQLite;
  SQL: String;
begin
  {$IFDEF DEBUG} writeln('CreateSalesRegister');  {$ENDIF}
  Result := false;
  SQLDB := TSQLite.Create(fn);
  if SQLDB <> nil then
     try
       SQL := 'BEGIN TRANSACTION;';
       SQL := SQL + 'CREATE TABLE SaleDetails (saleID integer, itemID integer, quantity integer, price float, refund integer);';
       SQL := SQL + 'CREATE TABLE SaleSummary (saleID, TerminalID integer, saletime float, itemcount integer, total float, staffID integer, refund integer DEFAULT 0, paymenttype integer);';
       SQL := SQL + 'CREATE TABLE Shifts (terminalid integer, staffid integer, starttime real, endtime real, startcash real, endcash real, startsaleid integer, endsaleid integer, checksum text);';
       Result := SQLDB.Query(SQL, nil);
       If not Result
          then begin
                 {$IFDEF DEBUG} writeln(SQLDB.LastErrorMessage); {$ENDIF}
                 SQLDB.Query('ROLLBACK;', nil);
               end
          else Result := SQLDB.Query('COMMIT;', nil);
     finally
       SQLDB.Free;
       try
         if not Result then DeleteFile(fn);
       except
       end;
     end;
end;

function CreateLogfile ( fn: TFilename ) : Boolean;
var
  SQLDB: TSQLite;
  SQL: String;
begin
  {$IFDEF DEBUG} writeln('CreateLogFile'); {$ENDIF}
  Result := false;
  SQLDB := TSQLite.Create(fn);
  if SQLDB <> nil then
     try
       SQL := 'CREATE TABLE TerminalLog (eventtime float, TerminalID integer, StaffID integer, event text);';
       writeln(SQL);
       Result := SQLDB.Query(SQL, nil);
       If not Result
          then begin
                 {$IFDEF DEBUG} writeln(SQLDB.LastErrorMessage); {$ENDIF}
               end;
     finally
       SQLDB.Free;
     end;
   try
     if not Result then DeleteFile(fn);
   except
   end;
end;

function CreateSystemConfig(fn: TFilename): Boolean;
var
  SQLDB: TSQLite;
  SQL: String;
begin
  {$IFDEF DEBUG} writeln('CreateSystemConfig'); {$ENDIF}
  Result := false;
  SQLDB := TSQLite.Create(fn);
  if SQLDB <> nil then
     try
       SQL := 'BEGIN TRANSACTION;';
       SQL := SQL + 'CREATE TABLE BusinessDetails (BusinessName text, InvoiceAddress text, DeliveryAddress text, telephone text, fax text, emailaddress text, ContactName text, lastordernum integer default 0);';
       SQL := SQL + 'INSERT INTO BusinessDetails VALUES ("Business name", "Invoice address", "As invoice address", "", "", "", "", 0);';
       SQL := SQL + 'CREATE TABLE Buttons (itemID integer, pagenum integer, row integer, col integer, visible integer);';
       SQL := SQL + 'CREATE TABLE Departments (id integer PRIMARY KEY, name text);';
       SQL := SQL + 'INSERT INTO Departments VALUES (0, "Default department");';
       SQL := SQL + 'CREATE TABLE Discounts(discountID integer primary key, description text, type integer, starttime float, endtime float, triggerquantity integer, discount float);';
       SQL := SQL + 'CREATE TABLE Invoices (invoiceID integer primary key, invoiceref text, supplierid integer, issuedate integer, duedate integer, amountdue float);';
       SQL := SQL + 'CREATE TABLE Pages (id integer PRIMARY KEY, title text NOT NULL, visible integer default 1, rows integer default 5, cols integer default 4);';
       SQL := SQL + 'CREATE TABLE Products (productid integer PRIMARY KEY, barcode UNIQUE, name text, costprice float, saleprice float, taxcode integer default 0, suppliercode integer, '
                       + 'stocklevel integer, dept integer, discount integer default 0, suppliersref text, discontinued integer default 0);';
       SQL := SQL + 'INSERT INTO Products VALUES (0, NULL, "Default department", 0.0, 0.0, 0, NULL, NULL, NULL, 0, NULL, 0);';
       SQL := SQL + 'CREATE TABLE Staff (id integer PRIMARY KEY, name text, pass text, privileges integer, checksum text);';
       SQL := SQL + 'INSERT INTO Staff VALUES (0, "Manager", "' + MDPrint(MD5String('Manager')) + '", 5, "' + Checksum('Manager', 'Manager', '5') + '");';
       SQL := SQL + 'INSERT INTO Staff VALUES (1, "Any staff member", NULL, 0, "' + Checksum('Any staff member', '', '0') + '");';
       SQL := SQL + 'CREATE TABLE Suppliers (id integer PRIMARY KEY,name text,address text, postcode text, telephone text, email text, contact text, notes text, website text, accountnum text);';
       SQL := SQL + 'CREATE TABLE Terminals (TerminalID integer PRIMARY KEY, name text, profile integer, lastsale integer, datarevision integer, screenwidth integer, screenheight integer);';
       SQL := SQL + 'CREATE TABLE Updates (updateid integer UNIQUE, updatetime real);';
       SQL := SQL + 'CREATE TABLE goodsordered (orderid integer, itemid integer, quantity integer);';
       SQL := SQL + 'CREATE TABLE goodsreceived (supplierid integer, invoiceid integer, date integer, productID text, quantity integer);';
       SQL := SQL + 'CREATE TABLE ordersout (orderid integer primary key, supplierid integer, date integer, orderedby integer, ordervalue float);';
       SQL := SQL + 'CREATE INDEX suppliername ON Suppliers(name);';

       SQL := SQL + 'CREATE TABLE Payments (id integer PRIMARY KEY, name text);';
       SQL := SQL + 'INSERT INTO Payments VALUES (0, "Cash");';
       SQL := SQL + 'INSERT INTO Payments VALUES (1, "Card");';
       SQL := SQL + 'INSERT INTO Payments VALUES (2, "Cheque");';
       Result := SQLDB.Query(SQL, nil);
       If not Result
          then begin
                 {$IFDEF DEBUG} writeln(SQLDB.LastErrorMessage); {$ENDIF}
                 SQLDB.Query('ROLLBACK;', nil);
               end
          else Result := SQLDB.Query('COMMIT;', nil);
     finally
       SQLDB.Free;
       try
         if not Result then DeleteFile(fn);
       except
       end;
     end;
end;

function CreateProfile(fn: TFilename; name, description: string): Boolean;
// Profiles now unused
var
  SQLDB: TSQLite;
  SQL: String;
begin
  writeln('CreateProfile');
  Result := false;
  SQLDB := TSQLite.Create(fn);
  if SQLDB <> nil then
     begin
       SQL := 'CREATE TABLE Profile (profileID integer PRIMARY KEY, name text, description text, isdefault integer);';
       if not SQLDB.Query(SQL, nil) then writeln(SQLDB.LastErrorMessage);
       SQL := 'INSERT INTO Profile (name, description, isdefault) VALUES ("' + name + '", "' + description +'", 0);';
       if not SQLDB.Query(SQL, nil) then writeln(SQLDB.LastErrorMessage);
       SQL := 'CREATE TABLE Buttons (itemID integer, pagenum integer, row integer, col integer, visible integer);';
       if not SQLDB.Query(SQL, nil) then writeln(SQLDB.LastErrorMessage);
       SQL := 'CREATE TABLE Pages (id integer PRIMARY KEY, title text NOT NULL, visible integer default 1, rows integer default 5, cols integer default 4);';
       if not SQLDB.Query(SQL, nil) then writeln(SQLDB.LastErrorMessage);
       SQL := 'INSERT INTO Pages (id, title, visible, rows, cols) VALUES (0, "Default page", 1, 5, 4);';
       if not SQLDB.Query(SQL, nil) then writeln(SQLDB.LastErrorMessage);
     end;
  Result := SQLDB.LastError=0;
  SQLDB.Free;
end;

procedure SetDefaultProfile ( fn: TFilename ) ;
var
  searchResult : TSearchRec;
begin
  // Try to find regular files matching *.profile
  if FindFirst(ExtractFilePath(fn) + '*.profile', faAnyFile, searchResult) = 0 then
  begin
    repeat
      writeln(searchResult.Name);
      if searchResult.Name=fn
         then ExecuteSQL(fn, 'UPDATE `Profile` SET `isdefault`=1 WHERE 1')
         else ExecuteSQL(fn, 'UPDATE `Profile` SET `isdefault`=0 WHERE 1');
    until FindNext(searchResult) <> 0;

    // Must free up resources used by these successful finds
    FindClose(searchResult);
  end;
end;

function ExecuteSQL ( fn: TFilename; SQL: string ) : integer;
var
  SQLDB: TSQLite;
  SQLQuery: String;
  ErrCode: integer;
begin
  writeln('ExecuteSQL');
  ErrCode := 0;
  SQLDB := TSQLite.Create(fn);
  if SQLDB <> nil then
     begin
       fn := ExtractFilePath(fn) + ExtractFileName(SYSTEM_CONFIG);
       SQLDB.Query('ATTACH "' + fn + '" AS system;', nil );
       SQLQuery := 'BEGIN TRANSACTION;';
       if Pos(SQLQuery, SQL)<1 then SQL := SQLQuery + SQL;
       if not SQLDB.Query(SQL, nil) then ErrCode := SQLDB.LastError;
       {$IFDEF DEBUG} if ErrCode>0 then WriteLn(SQL,#10,SQLDB.ErrorMessage(ErrCode)); {$ENDIF}
       if ErrCode=0
          then SQLQuery := 'COMMIT'
          else SQLQuery := 'ROLLBACK';
       SQLDB.Query(SQLQuery, nil);
     end;
  Result := ErrCode;
  SQLDB.Free;
end;

function Checksum ( str1, str2, str3: string ) : string;
begin
  result := MD5Print(MD5String(str1+str2+str3));
end;

function CheckPass ( pass: string ) : string;
begin
  Result := MD5Print(MD5String(pass));
end;

function EscapeQuotes(str: string): string;
var
  x: Integer;
begin
  Result := str;
  for x := Length(str) downto 1 do
      if str[x] = #39 then
           Insert( #39, Result, x);
end;

function IsValidCost(Value: string): Boolean;
var
  i: double;
begin
  Result := TryStrToFloat(Value, i);
end;

function MaxIntOf ( int1, int2: Integer ) : Integer;
begin
  if int1>int2
     then Result := int1
     else Result := int2;
end;

function RandomString(len: Integer): string;
const
  Chars = 'abcdefghijklmnopqrstuvwxyz1234567890ABCDEFGHIJKLMNOPQRSTUVWXYZ';
var
  r: string;
  x: Integer;
  N: Integer;
begin
  Randomize;
  SetLength(r, len);
  for x := 1 to len do
      begin
        N := Random(Length(Chars)) + 1;
        r[x] := Chars[n];
      end;
  Result := r;
end;

function DateTimeToJulianDateTime ( datetime: TDateTime ) : Double;
begin
  Result := datetime + 2415018.5;
end;

function DateTimeToJulianDateTimeAsString ( datetime: TDateTime ) : String;
begin
  Result := FloatToStr(DateTimeToJulianDateTime(datetime));
end;

function JulianDateTimeToString ( juliandatetime: TJulianDateTime ) : String;
begin
  Result := FloatToStr(juliandatetime);
end;

function FormatJulianDateTime ( const FormatStr: string;
  DateTime: TJulianDateTime ) : string;
begin
  Result := FormatDateTime(FormatStr, JulianDateTimeToDateTime(DateTime));
end;

function JulianDateTimeToDateTime ( juliandatetime: TJulianDateTime ) : TDateTime;
begin
  Result := juliandatetime-2415018.5;
end;

function EscapeLineEnding(str: string): string;
var
  x: SizeInt;
begin
  x := Pos(LineEnding, str);
  while x>0 do
        begin
          str := system.Copy(str, 1, x-1) + '\r' + system.Copy(str, x+1, MaxInt);
          x := Pos(LineEnding, str);
        end;
  Result := str;
end;

function UnEscapeLineEnding ( str: string ) : string;
var
  outstr: String;
  x: SizeInt;
begin
  Result := '';
  outstr := '';
  x := Pos('\r', str);
  while x>0 do
        begin
          outstr := outstr + system.Copy(str, 1, x-1) + LineEnding;
          Delete(str, 1, x+1);
          x := Pos('\r', str);
        end;
  outstr := outstr + str;
  Result := outstr;
end;

function EscapeApostrophe ( data: string ) : string;
var
  x: Integer;
begin
  Result := data;
  for x := Length(data) downto 1 do
      if data[x] = #39 then Insert(#39, data, x);
  Result := data;
end;


// NOTE: another pointer to the input buffer must exist to allow it to be Freed
function CompressBuffer ( var Buffer: Pbyte; var bufferlen: Cardinal ) : Boolean;
var
  complen: Cardinal;
  outbuf: PByte;
begin
  complen := Round(bufferlen*1.2);
  Getmem(outbuf, complen);
  FillChar(outbuf^, complen, #0);
  Result := compress(outbuf, complen, Buffer^, bufferlen)=0;
  if Result then
     begin
       Buffer := outbuf;
       bufferlen := complen;
     end;
end;

function DeCompressBuffer ( var Buffer: PByte; bufferlen, destlen: Cardinal ) : PChar;
var
  outbuf: PByte;
  err: LongInt;
begin
  Result := nil;
  Getmem(outbuf, destlen);
  FillChar(outbuf^, destlen, #0);
  err := uncompress(outbuf, destlen, Buffer^, bufferlen);
  if err=Z_OK then Result := PChar(outbuf)
  {$IFDEF DEBUG}
  else if err=Z_MEM_ERROR then writeln('Insufficient memory when decompressing')
  else if err=Z_DATA_ERROR then writeln('Input data corrupt when decompressing')
  {$ENDIF};
end;

function FormatNumber( Prefix: string; Num, Len: integer ): string;
var
  NumAsString: string;
begin
  NumAsString := IntToStr(Num);
  while Length(NumAsString) < Len do
        NumAsString := '0' + NumAsString;
  Result := Prefix + NumAsString;
end;


end.
